home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / eg0519s.zip / PAL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  3KB  |  118 lines
  1. (*
  2.  * Copyright 1990 Eric Ng
  3.  *
  4.  * This program is free software; you can redistribute it and(*or modify
  5.  * it under the terms of the GNU General Public License as published by
  6.  * the Free Software Foundation; either version 1, or (at your option)
  7.  * any later version.
  8.  *
  9.  * This program is distributed in the hope that it will be useful, but
  10.  * without any warranty whatsoever, without even the implied warranties
  11.  * of merchantability or fitness for a particular purpose.  See the
  12.  * accompanying GNU General Public License for more details.
  13.  *
  14.  * You should have received a copy of the GNU General Public License
  15.  * along with this program; see the file COPYING.  If not, write to:
  16.  *
  17.  * Free Software Foundation, Inc.
  18.  * 675 Massachusetts Avenue
  19.  * Cambridge, Massachusetts 02139
  20.  *)
  21.  
  22. { this was a quick and dirty hack which I threw together in order to
  23.   determine the default palette values for egaint 0.93.07; this means that
  24.   this was written almost one full year ago, so I make no apologies for
  25.   the condition of this code -eric }
  26.  
  27. program x;
  28.  uses crt, dos, graph, driver;
  29.  const
  30.   filltab : array[1..4] of fillpatterntype =
  31.       (($ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff),
  32.        ($aa, $55, $aa, $55, $aa, $55, $aa, $55),
  33.        ($99, $cc, $66, $33, $99, $cc, $66, $33),
  34.        ($99, $33, $66, $cc, $99, $33, $66, $cc));
  35.  var gd:integer;
  36.   gm:integer; buf:string[32];
  37.  var i,j,k,l,m,n,o,p:integer;
  38.      c,a,b:char;
  39.      col:array[1..15] of shortint;
  40.  begin
  41.    col[1] := 7;
  42.    col[2] := 63;
  43.    col[3] := 47;
  44.    col[4] := 49;
  45.    col[5] := 25;
  46.    col[6] := 27;
  47.    col[7] := 10;
  48.    col[8] := 50;
  49.    col[9] := 44;
  50.    col[10] := 37;
  51.    col[11] := 39;
  52.    col[12] := 36;
  53.    col[13] := 38;
  54.    col[14] := 55;
  55.    col[15] := 62;
  56.   if registerbgidriver(@EGAVGADriver) < 0 then
  57.    halt(0);
  58.   gd:=ega; gm:=egahi;
  59.   initgraph(gd, gm, '');
  60.     settextjustify(centertext, toptext);
  61.      settextstyle(smallfont, horizdir, 4);
  62.   setcolor(2);
  63.   for i:=1 to 15 do
  64.    begin
  65.     setpalette(i, col[i]);
  66.     outtextxy((i-1)*42+20, 330, chr(i+ord('a')-1)+chr(i+ord('A')-1));
  67.    for j:=1 to 4 do
  68.     begin
  69.      setfillpattern(filltab[j], i);
  70.      bar((i-1)*42, (j-1)*77, i*42-5, j*77-7);
  71.     end;
  72.     end;
  73.   repeat
  74.    for i := 1 to 15 do
  75.     begin
  76.      setcolor(2);
  77.      str(col[i]:2,buf);
  78.      outtextxy((i-1)*42+20, 340, buf);
  79.     end;
  80.   repeat until keypressed;
  81.   a:=readkey;
  82.   if a in ['A'..'O'] then
  83.    begin
  84.     k:=ord(a)-ord('A')+1;
  85.     str(col[k]:2,buf);
  86.     setcolor(0);
  87.     outtextxy((k-1)*42+20, 340, buf);
  88.  
  89.     col[k]:=col[k]+1;
  90.     if col[k]>63 then col[k]:=0;
  91.     setpalette(k, col[k]);
  92.  
  93.     str(col[k]:2,buf);
  94.     setcolor(2);
  95.     outtextxy((k-1)*42+20, 340, buf);
  96.  
  97.    end;
  98.   if a in ['a'..'o'] then
  99.    begin
  100.     k:=ord(a)-ord('a')+1;
  101.     str(col[k]:2,buf);
  102.     setcolor(0);
  103.     outtextxy((k-1)*42+20, 340, buf);
  104.     col[k]:=col[k]-1;
  105.     if col[k]<0 then col[k]:=63;
  106.     setpalette(k, col[k]);
  107.     str(col[k]:2,buf);
  108.     setcolor(2);
  109.     outtextxy((k-1)*42+20, 340, buf);
  110.    end;
  111.   until a = #27;
  112.  textmode(c80);
  113.  write('palette=0,');
  114.  for i := 1 to 14 do
  115.   write(col[i], ',');
  116.  writeln(col[15]);
  117. end.
  118.